#!/usr/bin/perl -X # vim: foldmethod=marker use strict; use warnings; use 5.010; use utf8;use open qw/:std :utf8/; use ORFText; =pod TODO: %headings won't register when topstory is missing (->sportarten) this is version 2.0 of ttxd values for query string/cookie: - special flags start with _ - _noqna: hide "fragen/antworten" (set by default) - numeric: pagenumbers =cut my $pages = $ENV{HTTP_COOKIE} // join '&', ( 101, 113 .. 125, # Politik: Österreich/EU 127 .. 134, # Politik: International 102,#136 .. 144, # Chronik # 701 .. 709 # Bundesländer (W-NÖ-B-OÖ-S-T-V-K-St) # 471 .. 478 # Nachrichten leicht verständlich # 103, 146 .. 149 # Leute # 104, 151 .. 159 # Wirtschaft # 161,167,169, # Börse # 170,172,174 # -"- # 105, 203 .. 209, # Sport vom Tag # 210 .. 259, # Sportarten # 261 .. 278, # Wintersport & Großereignisse # 107,110,191..198, # Show und Kultur 108,#461 .. 465, # Web/Media # 468 .. 469, # Webtipps # Special Flags: "_noqna", # hide Q-and-A ); my @pages = split /&/, ($ENV{QUERY_STRING} =~ s/(\d{3})-(\d{3})/${\join'&',$1..$2}/gr) // $pages; # pages from query string won't affect cookie #print "Set-Cookie: $pages; Max-Age=2147483647\r\n"; print "Content-type: text/html\r\n\r\n"; # html format {{{ $ORFText::REF_MARKUP = sub { return qq{$_[0]$_[1]} }; sub format_table { my $text = join("\n",map{s/[\x00-\x20]/ /gr}@{%{$_[0]}{raw}})=~s/^ ,,+//msr=~s/\n+$//r; return {%$_, text=>"

$text

"}; } sub format_html { my %page = %{$_[0] or return}; no warnings 'numeric'; use List::Util qw[max]; sub ifdef { $_[1]? "$_[0]$_[1]":"" } my $pagespec = substr($page{page},0,1) ."00/$page{page}_000".max($page{subpage},1); return <<"HTML";

$page{page}${\ifdef('.',$page{subpage})}: $page{title}

$page{text} ➤

HTML } # }}} # headings {{{ my %headings = ( 101 => "Politik: Österreich/EU", 127 => "Politik: International", 102 => "Chronik", 103 => "Leute", 104 => "Wirtschaft", 161 => "Börse", 105 => "Sport", #203 => "Sport vom Tag", #260 => "Wintersport und Großereignisse" 106 => "Fernsehen", 108 => "Multimedia", 107 => "Kultur & Show", # XXX: this will show it multiple times! 110 => "Kultur & Show", 109 => "Wetter", 471 => "Nachrichten leicht verständlich", 481 => "Nachrichten leichter verständlich", 701 => "Wien", 702 => "Niederösterreich", 703 => "Burgenland", 704 => "Oberösterreich", 705 => "Salzburg", 706 => "Tirol", 707 => "Vorarlberg", 708 => "Kärnten", 709 => "Steiermark", ); # }}} # html-head {{{ print <<'EOF'; ORFText News

ORFText News

EOF # }}} my (@all, @nonempty); page:foreach (grep/[0-9]/,@pages) { print "

$headings{$_}

\n" if $headings{$_}; my $pageno = $_; push @all, $pageno; foreach (glob "/run/ttxd/spool/2/${_}_*.vtx") { my $file_age = time - (stat)[9]; next if $file_age > 300; for (ORFText::html($_)) { next unless $_; # fail req'd for $nonempty if ("_noqna" ~~ @pages) { # hide Q-and-A next page if %{$_}{text}=~m@[Aa]lle Fra.?gen/Antworten.+?500@;# /.?/ is a soft hyphen } $_ = format_table $_ if %$_{tabular}; print format_html $_ ; push @nonempty, $pageno; } } } sub subtr { return grep{not%{{map{$_=>1}@{$_[1]}}}{$_}} @{$_[0]}; } sub uniq { return sort keys %{{@_}}; } my @empty = uniq subtr [sort @all], [@nonempty]; # WARN: uniq breaks when sort is removed! my ($N, $n) = ('n'x!!$#empty, 'n'x!!$#all); print "

"; print "Tafel$N @{[join ', ', @empty]} wurde$N nicht gefunden. " if @empty; print "

"; print "

"; print "

".join ' | ', ( 'Politik', 'Chronik', 'Bundesländer', 'einfache Sprache', 'Leute', 'Multimedia', 'Kultur & Show', 'Wirtschaft', 'Börse', 'Sport', 'Topstories', ); print "

"; print "

";